COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "PICSHE"
C00009 ENDMK
C⊗;
BEGIN "PICSHE"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
DO
  BEGIN "PICBLK"
  INTEGER I,J,K,L,M,PL,LN;  STRING PFL;
  INTEGER ARRAY PC[0:10],BUF[0:20];
  INTEGER COUNT,BRCHAR,EOF,CH; BOOLEAN FLAG;

  DEFINE WID=1600, HIG=1200;

  PRINT("Picture file:");  PFL←INCHWL; GETPFD(PFL,PC[0]);

  CH←GETCHAN; PRSFIL(PFL); EOF←TRUE;
  OPEN(CH,DEVPRS,'10,19,0,COUNT,BRCHAR,EOF);
  IF ¬EOF THEN LOOKUP(CH,FILPRS,FLAG);
  IF FLAG ∨ EOF THEN
     BEGIN
     RELEASE(CH);
     PRINT("Picture file ",PFL," not found",'15&'12);
     DONE "PICBLK";
     END;
   ARRYIN(CH,BUF[0],10);
   IF BUF[0]=-1 THEN
     BEGIN "new HE format"
     ARRYIN(CH,BUF[10],9);
     I←'200;
       comment in case file is MIT pseudo stanford format, and has no pointers;
     FOR K←18,17,16,15,10,9,8,7 DO IF BUF[K]≠0 THEN I←BUF[K];
     PC[BYBI]←BUF[1];
     PC[LNBY]←BUF[6]-BUF[5]+1;
     PC[PCLN]←BUF[4]-BUF[3]+1;
     PC[WDBY]←36%PC[BYBI];
     PC[LNWD]←BUF[2];
     PC[LNBYA]←PC[LNWD]*PC[WDBY];
     PC[PCWD]←PC[PCLN]*PC[LNWD];
     PC[PCBY]←PC[PCLN]*PC[LNBY];
     PC[PCBYA]←PC[PCLN]*PC[LNBYA];
     PC[WDBI]←PC[WDBY]*PC[BYBI];
     I←(I LAND '777777);
     FOR J←19 STEP 1 UNTIL I-1 DO WORDIN(CH); comment skip to first scanline;
     END
   ELSE
     BEGIN   comment if old hand eye format;
     PC[BYBI]←BUF[2];
     PC[LNBY]←BUF[8]-BUF[7]+1;
     PC[PCLN]←BUF[6]-BUF[5]+1;
     PC[WDBY]←36%PC[BYBI];
     PC[LNWD]←(PC[LNBY]+PC[WDBY]-1)%PC[WDBY];
     PC[LNBYA]←PC[LNWD]*PC[WDBY];
     PC[PCWD]←PC[PCLN]*PC[LNWD];
     PC[PCBY]←PC[PCLN]*PC[LNBY];
     PC[PCBYA]←PC[PCLN]*PC[LNBYA];
     PC[WDBI]←PC[WDBY]*PC[BYBI];
     IF PC[BYBI]≤0 ∨ PC[BYBI]>36 ∨ PC[LNBY]≤0 ∨ PC[PCLN]≤0 ∨ BUF[0]<0 THEN
       BEGIN
       RELEASE(CH);
       PRINT(" ",PFL," is not a picture file",'15&'12);
       DONE "PICBLK";
       END;
     END;

     BEGIN
     INTEGER LW; LABEL DOTPL,BPTDL; REAL BM;
     PRELOAD_WITH '777, '377, '376, '372, '272, '270,'070, '030, '020, '000;
     OWN INTEGER ARRAY DOTS[0:9]; INTEGER ARRAY DOTP[0:9];

     INTEGER ARRAY
        SCNLIN[0:PC[LNWD]-1],BPTS,BPTD[0:WID%3],PIC[0:PIXDIM(HIG,WID+36,1)];
     REAL ARRAY ERRS[-1:WID%3+1];

     PRELOAD_WITH  .9375,.1875,.4375,.6875,.75,0,.25,.5,
     .8125,.0625,.3125,.5625,.875,.125,.375,.625; OWN REAL ARRAY H[0:15];

     MAKPIX(HIG,WID+36,1,PIC[0]);
     FOR J←0 STEP 1 UNTIL 9 DO DOTP[J]←POINT(3,DOTS[J],26);
     L←POINT(3,MEMORY[PIC[LINTAB]+1],-1);
     FOR J←0 STEP 1 UNTIL (WID-1)%3 DO
       BEGIN
       K←J*PC[LNBY]*3%WID;
       BPTS[J]←POINT(PC[BYBI],SCNLIN[K%PC[WDBY]],((K MOD PC[WDBY])+1)*PC[BYBI]-1);
       IBP(L); BPTD[J]←L;
       END;
     LW←PIC[LNWD];
     BM←9/PC[BMAX];
     
     I←LOCATION(DOTP[0]); START_CODE MOVE 0,I; HRRM 0,DOTPL; END;
     I←LOCATION(BPTD[0]); START_CODE MOVE 0,I; HRRM 0,BPTDL; END;
     I←LOCATION(BPTS[0]); START_CODE MOVE 0,I; HRRM 0,BPTSL; END;
     I←LOCATION(ERRS[0]); START_CODE MOVE 0,I; HRRM 0,ERRSL; HRRM 0,ERRSM;
                          ADDI 0,1; HRRM 0,ERRSP; SUBI 0,2; HRRM 0,ERRSM; END;
     PL←-1;
     FOR I←0 STEP 1 UNTIL (HIG-1)%3 DO
	BEGIN
        INTEGER LWI; REAL ERP;
	LN←I*PC[PCLN]*3%HIG;  LWI←LW*3*I;
        FOR PL←PL STEP 1 UNTIL LN DO ARRYIN(CH,SCNLIN[0],PC[LNWD]);
        ERP←0;
	FOR J←(I LAND 1) STEP 2 UNTIL (WID-1)%3 DO
	   BEGIN
           INTEGER T;
	   REAL ER;
	   ER←ERRS[J]+LDB(BPTS[J])*BM; T←ER;
	   ER←ER-T;
	   ER←ER*0.25;
	   ERRS[J]←ER+ERP;
	   ERRS[J-1]←ERRS[J-1]+ER;
	   ERRS[J+1]←ERRS[J+1]+ER*1.5;
	   ERP←ER*0.5;
           START_CODE MOVE 2,J; BPTSL: LDB 0,(2); FLOATR 0,0;
                      FMPR 0,BM; ERRSL: FADR 0,(2); FIXR 1,0;
		      FLOATR 3,1; FSBR 0,3; FSC 0,-2; ERRSM:MOVE 0,ERP;
        
                      DOTPL: MOVE 3,(1); BPTDL: MOVE 4,(2);  ADD 4,LWI;
                      ILDB 0,3; DPB 0,4; ADD 4,LW;
                      ILDB 0,3; DPB 0,4; ADD 4,LW; ILDB 0,3; DPB 0,4; END;
	   END;
	END;
     RELEASE(CH);
     PUTPFL(PIC[0],"DSK:FOO.TMP[TMP,HPM]");
     VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
     VIDXGP(PIC[0],100,(1620-WID)%2,HIG+200);
     END;
   END "PICBLK" UNTIL TRUE;
END "PICSHE";